home *** CD-ROM | disk | FTP | other *** search
/ United Public Domain Gold 2 / United Public Domain Gold 2.iso / utilities / pu295.dms / pu295.adf / Logging / VhfLog / VHFLOG.BAS < prev    next >
BASIC Source File  |  1988-12-18  |  10KB  |  301 lines
  1. ' VHFLOG.BAS version 1.3
  2. ' Copyright (© 1986,1987 by Clarke Greene K1JX) NOT FOR COMMERCIAL USE
  3. ' Amiga Version by John Gager-K7KB
  4. '
  5. ' This Microsoft (tm) BASIC program will build a complete log package
  6. ' for any of the ARRL VHF Contests.
  7. '
  8. ' The file containing the log entries must be an ASCII file in the
  9. ' following format: 
  10. '               (Each band requires a separate log entry file)
  11. '
  12. ' TIME   CALLSIGN   RCV'D GRID SQUARE
  13. ' (each LOG entry must be followed by a carriage RETURN)
  14. '
  15. ' At least one space must be between each field of each log entry. Only
  16. ' a changed digit in the time field must be present; FOR example, IF the
  17. ' contest begins at 1800Z AND the first contact is made at 1802Z AND the
  18. ' second contact is made at 1805Z, THEN only 5 need be entered in the
  19. ' TIME field. IF the third contact is made at 1812 Z, THEN 12 should be
  20. ' entered in the TIME field. IF the NEXT contact is made at 1812Z, THEN
  21. ' no number need be entered in the TIME FIELD (however, be sure TO enter
  22. ' a space TO indicate separation between fields)!
  23. '
  24. ' These files will be produced:
  25. '
  26. ' <filename>.LOG - this is a complete log ready for printing
  27. ' <filename>.DUP - this is a sorted duplicate listing ready for printing
  28. ' <filename>.SUM - this is a summary sheet ready for printing
  29. '
  30. '
  31. ' Depending on the version of BASIC for your particular machine, the CLS
  32. ' (CLEAR SCREEN) command must be changed. Consult your own computer's
  33. ' BASIC documentation FOR more information.
  34. '
  35. '
  36. ' If compiling (a VERY good idea for several orders of magnitude
  37. ' improvement in speed), use O AND E switches. 
  38. '
  39. '  Define arrays and variables
  40. '
  41. CLEAR ,42000&:DEFINT a-Z : OPTION BASE 1
  42. DIM ENTRY$(1500), GRID$(1500), MULT$(250), Q(250), MONTH$(12)
  43. BLANK$=" " : BL$="" : TRUE=-1
  44. FOR X=1 TO 12:READ MONTH$(X):NEXT
  45. DATA Jan.,Feb.,Mar.,Apr.,May.,June,July,Aug.,Sept.,Oct.,Nov.,Dec.
  46. DUPE$="- Duplicate QSO -" : DIFGRID$="Station in new Grid" : NEWGRID$=" - Mult. #"
  47. '  Define format strings for printouts
  48. LOGFORM$="   \       \ \  \     \           \     \  \     \  \     \                   \"
  49. DUPFORM$="      \         \   \          \   \          \   \          \   \          \"
  50. SUMFORM$="     \         \    \         \    \         \    \         \    \         \"
  51. '
  52. '  Get information from user
  53. '
  54. CLS
  55. COLOR 3:PRINT TAB(27) " VHF Contest Log Processor " : PRINT : PRINT
  56. COLOR 1:PRINT : PRINT TAB(5) "What is the station callsign?  ";
  57. INPUT "", MYCALL$ : MYCALL$=UCASE$(MYCALL$)
  58.  
  59. EnterGrid:
  60.  
  61. PRINT : PRINT TAB(5) "What Grid Square is the station in?  ";
  62. INPUT "", MYGRID$ : MYGRID$=UCASE$(MYGRID$)
  63. IF LEN(MYGRID$)<>4 THEN PRINT CHR$(7);: GOTO EnterGrid
  64.  
  65. EnterDate:
  66.   
  67. PRINT : PRINT TAB(5) "What is the beginning date of the contest";
  68. COLOR 3 : PRINT" <DD/MM/YY> ";
  69. COLOR 1 : INPUT "", STARTDATE$
  70. MARK=INSTR(STARTDATE$,"/") : IF MARK=0 THEN MARK=INSTR(STARTDATE$,"-")
  71. STARTDAY=VAL(LEFT$(STARTDATE$,MARK-1))
  72. STARTDATE$=RIGHT$(STARTDATE$,LEN(STARTDATE$)-MARK)
  73. MARK=INSTR(STARTDATE$,"/") : IF MARK=0 THEN MARK=INSTR(STARTDATE$,"-")
  74. MON$=MONTH$(VAL(LEFT$(STARTDATE$,MARK-1)))
  75. YR$=RIGHT$(STARTDATE$,LEN(STARTDATE$)-MARK)
  76.   
  77. PRINT : PRINT TAB(5) "What is the GMT starting time for the contest?  ";
  78. INPUT "", STARTGMT$
  79.  
  80. GetLog:
  81.  
  82. PRINT : PRINT TAB(5) "What file is the log extract located in?  ";
  83. INPUT "", INFILE$
  84. GOSUB CheckFile                      ' check to see if file exists
  85. IF INSTR(INFILE$,".")<>0 THEN OUTFILE$=LEFT$(INFILE$,INSTR(INFILE$,".")-1) ELSE OUTFILE$=INFILE$
  86. PRINT : PRINT TAB(5) "What frequency band is the log extract for?  ";
  87. INPUT "", BAND$
  88. '
  89. '  Collect log extract from input file and assign data to arrays
  90. '
  91. FOR I=1 TO 250
  92.   MULT$(I)=BL$
  93.   Q(I)=1
  94. NEXT
  95. CLS
  96. PRINT : PRINT TAB(5) "Duping and counting...";
  97. '
  98. '  Initialize variables
  99. '
  100. RAWTOTAL=0 : QSOS=0 : DUPES=0 : MULTNR=0  ' initialize counters
  101. DAY=STARTDAY : PREVIOUSGMT$=STARTGMT$     ' (re)set starting time and day
  102. '
  103. '  Open input data file and output .LOG file
  104. '
  105. OPEN INFILE$ FOR INPUT AS #1 LEN=5000
  106. OPEN OUTFILE$+".LOG" FOR OUTPUT AS #2 LEN=5000
  107. '
  108. '  Input data, process, and enter into output file
  109. '
  110. WHILE NOT EOF(1)
  111.   LINE INPUT #1, THISENTRY$  ' read entire line from disc file
  112.   WHILE ASC(RIGHT$(THISENTRY$,1))<48 AND LEN(THISENTRY$)>0
  113.     THISENTRY$=LEFT$(THISENTRY$,LEN(THISENTRY$)-1) ' strip off trailing spaces,etc
  114.   WEND
  115.   IF LEN(THISENTRY$)>0 THEN RAWTOTAL=RAWTOTAL+1 ELSE GOTO SkipEntry
  116.   '
  117.   '  Separate grid from THISENTRY$
  118.   '
  119.   THISGRID$=RIGHT$(THISENTRY$,4)
  120.   THISGRID$=UCASE$(THISGRID$)
  121.   THISENTRY$=LEFT$(THISENTRY$,LEN(THISENTRY$)-4)
  122.   WHILE ASC(RIGHT$(THISENTRY$,1))<48
  123.     THISENTRY$=LEFT$(THISENTRY$,LEN(THISENTRY$)-1) ' strip off trailing spaces
  124.   WEND
  125.   '
  126.   '  Separate GMT from THISENTRY$
  127.   '
  128.    WHILE ASC(LEFT$(THISENTRY$,1))<48
  129.      THISENTRY$=RIGHT$(THISENTRY$,LEN(THISENTRY$)-1) ' strip off leading spaces
  130.    WEND
  131.    IF INSTR(THISENTRY$,BLANK$)<>0 THEN GMT$=LEFT$(THISENTRY$,INSTR(THISENTRY$,BLANK$)-1) ELSE GMT$=BL$
  132.    THISENTRY$=RIGHT$(THISENTRY$,(LEN(THISENTRY$)-LEN(GMT$)))
  133.    WHILE LEFT$(THISENTRY$,1)=BLANK$
  134.      THISENTRY$=RIGHT$(THISENTRY$,LEN(THISENTRY$)-1) ' strip off leading spaces
  135.    WEND
  136.    THISENTRY$=UCASE$(THISENTRY$)
  137.    ' 
  138.    '  Fill in missing time data 
  139.    '
  140.    GMT$=LEFT$(PREVIOUSGMT$,(4-LEN(GMT$)))+GMT$
  141.    THEDATE$=BL$ : IF GMT$<PREVIOUSGMT$ THEN DAY=DAY+1 : THEDATE$=STR$(DAY)+BLANK$+MON$
  142.    '
  143.    '  Check for dupes
  144.    '
  145.    DUPE.QSO=NOT TRUE : NOTE$=BL$ ' clear note field
  146.    FOR I=1 TO QSOS
  147.      IF THISENTRY$=ENTRY$(I) AND THISGRID$<>GRID$(I) THEN NOTE$=DIFGRID$
  148.      IF THISENTRY$=ENTRY$(I) AND THISGRID$=GRID$(I) THEN NOTE$=DUPE$ : DUPES=DUPES+1 : DUPE.QSO=TRUE : I=QSOS
  149.    NEXT
  150.    IF DUPE.QSO GOTO WriteEntry ' if contact is a dupe, skip over multiplier search
  151.    QSOS=QSOS+1 : ENTRY$(QSOS)=THISENTRY$ : GRID$(QSOS)=THISGRID$
  152.    '
  153.    '  Check for multipliers
  154.    '
  155.    NEWMULT=TRUE       ' initially set multiplier flag true
  156.    FOR I=1 TO MULTNR 
  157.      IF MULT$(I)=THISGRID$ THEN Q(I)=Q(I)+1 : NEWMULT=NOT TRUE : J=MULTNR
  158.    NEXT
  159.    IF NEWMULT THEN MULTNR=MULTNR+1 : MULT$(MULTNR)=THISGRID$ : NOTE$=THISGRID$+NEWGRID$+STR$(MULTNR)
  160.    '
  161.    '  Write entry to file
  162.    '
  163.    WriteEntry:
  164.    
  165.    IF (RAWTOTAL-1) MOD 50=0 THEN GOSUB PrintHeader ' print the header if this is the beginning of a page
  166.    PRINT #2, USING LOGFORM$; THEDATE$; GMT$; THISENTRY$; MYGRID$; THISGRID$; NOTE$
  167.    IF RAWTOTAL MOD 50=0 THEN PRINT #2, CHR$(12) ' print a form feed if this is the end of the page
  168.    '
  169.    '  Update variables for next entry
  170.    '
  171.    PREVIOUSGMT$=GMT$ : GMT$=BL$
  172.    
  173. SkipEntry:
  174. WEND
  175.  
  176. IF RAWTOTAL MOD 50 <>0 THEN PRINT #2, CHR$(12)              ' if a form feed wasn't printed, print one now
  177. CLOSE
  178. COLOR 3 : PRINT "Done" : COLOR 1
  179. '
  180. '  Build dupe sheet
  181. '
  182. PRINT : PRINT TAB(5) "Preparing dupe sheet...";
  183. '
  184. '  Sort callsigns for dupe sheet
  185. '
  186. M=QSOS\2
  187. WHILE M>0
  188.   FOR I=M+1 TO QSOS
  189.     J=I-M
  190.     WHILE J>0
  191.       IF ENTRY$(J)>ENTRY$(J+M) THEN SWAP ENTRY$(J),ENTRY$(J+M) : J=J-M ELSE J=0
  192.     WEND
  193.   NEXT
  194.   M=M\2
  195. WEND
  196.  
  197. '
  198. '  Enter dupe sheet into file
  199. '
  200. OPEN OUTFILE$+".DUP" FOR OUTPUT AS #1
  201. IF QSOS MOD 250=0 THEN LASTPAGE=QSOS\250 ELSE LASTPAGE=QSOS\250+1
  202. FOR PAGE=1 TO LASTPAGE
  203.   PRINT #1, SPC(20-(LEN(MYCALL$)+LEN(BAND$))/2); MYCALL$; " -- Dupe Sheet for "; BAND$; " MHz Band -- Page"; STR$(PAGE)
  204.   PRINT #1, BL$ : PRINT #1, BL$
  205.   FOR ROW=1 TO 50
  206.     E=(PAGE-1)*250+ROW
  207.     PRINT #1, USING DUPFORM$; ENTRY$(E); ENTRY$(E+50); ENTRY$(E+100); ENTRY$(E+150); ENTRY$(E+200)
  208.   NEXT
  209.   PRINT #1, CHR$(12)                    ' go to next page
  210. NEXT
  211. CLOSE
  212. COLOR 3 : PRINT "Done" : COLOR 1
  213. '
  214. '  Build summary listing
  215. '
  216. PRINT : PRINT TAB(5) "Preparing summary sheet...";
  217. '
  218. '  Sort multipliers for summary sheet
  219. '
  220. M=MULTNR\2
  221.   WHILE M>0
  222.     FOR I=M+1 TO MULTNR
  223.       J=I-M
  224.       WHILE J>0
  225.         IF MULT$(J)>MULT$(J+M) THEN SWAP MULT$(J),MULT$(J+M) : SWAP Q(J),Q(J+M) : J=J-M ELSE J=0
  226.       WEND
  227.     NEXT
  228.   M=M\2
  229. WEND
  230. '
  231. '  Append QSO per grid number to Grid Square
  232. '
  233. FOR I=1 TO MULTNR
  234.   MULT$(I)=MULT$(I)+" - "+STR$(Q(I))
  235. NEXT
  236. '
  237. '  Enter summary sheet into file
  238. '
  239. OPEN OUTFILE$+".SUM" FOR OUTPUT AS #1
  240. PRINT #1, SPC(12-(LEN(MYCALL$)+LEN(BAND$)+LEN(MON$))/2); MYCALL$; " -- Summary Sheet for "; BAND$;
  241. PRINT #1, " MHz Band -  "; MON$; " "; YR$; " VHF Contest" 
  242. PRINT #1, BL$
  243. PRINT #1, TAB(13); "Grid Square Listing and number of contacts per Grid"
  244. PRINT #1, BL$ : PRINT #1, BL$
  245. IF MULTNR MOD 5=0 THEN LASTROW=MULTNR\5 ELSE LASTROW=MULTNR\5+1
  246. FOR ROW=1 TO LASTROW
  247.   PRINT #1, USING SUMFORM$; MULT$(ROW); MULT$(ROW+LASTROW); MULT$(ROW+LASTROW*2); MULT$(ROW+LASTROW*3); MULT$(ROW+LASTROW*4)
  248. NEXT
  249. PRINT #1, BL$ : PRINT #1, BL$ : PRINT #1, BL$
  250. PRINT #1, TAB(18); "Total Valid QSOs - "; STR$(QSOS); TAB(45); "Dupes - "; STR$(DUPES)
  251. PRINT #1, TAB(18); "Grid Squares - "; STR$(MULTNR)
  252. PRINT #1, CHR$(12)
  253. CLOSE
  254. COLOR 3 : PRINT "Done" : COLOR 1
  255. '
  256. '  Print results
  257. '
  258. CLS : PRINT CHR$(7)
  259. PRINT : PRINT TAB(5) "Results for the "; BAND$; " MHz band" 
  260. PRINT : PRINT TAB (8)  "Valid QSOs:";:COLOR 3:PRINT USING "     ####";QSOS
  261. COLOR 1 : PRINT TAB(8) "Duplicate QSOs:"; : COLOR 3 : PRINT USING "  ###"; DUPES
  262. COLOR 1 : PRINT TAB(8) "Grid Squares:"; : COLOR 3 : PRINT USING "    ###"; MULTNR
  263. COLOR 1 : PRINT : PRINT : PRINT 
  264. PRINT TAB(5) "Type ";:COLOR 3:PRINT"C";:COLOR 1
  265. PRINT" to continue with another band,"
  266. PRINT TAB(5) "or any other key to Exit  ";
  267. InkeyLoop:
  268. I$=INKEY$:IF I$="" THEN GOTO InkeyLoop
  269. IF UCASE$(I$)="C" THEN CLS : GOTO GetLog ELSE CLS : END
  270. '
  271. '  Subroutine to trap missing file
  272. '
  273. CheckFile:
  274.  
  275. ON ERROR GOTO FileNotFound
  276. OPEN INFILE$ FOR INPUT AS #1                   ' try opening file
  277. ON ERROR GOTO 0
  278. CLOSE
  279. RETURN
  280. '
  281. '  Error trap for missing file
  282. '
  283. FileNotFound:
  284.  
  285. PRINT CHR$(7) : PRINT TAB(4) "That file does not exist - type X to Exit or any other key to continue ";
  286. ANS$=INPUT$(1) : IF ANS$="X" OR ANS$="x" THEN CLS : END
  287. PRINT 
  288. RESUME GetLog
  289. '
  290. '  Subroutine to print log sheet header
  291. '
  292. PrintHeader:
  293.  
  294. PRINT #2, BL$
  295. PRINT #2, TAB(5); MYCALL$; " "; BAND$; " MHz Log"; TAB(70); "Page"; STR$(RAWTOTAL\50+1)
  296. PRINT #2, BL$
  297. PRINT #2, "     Date    Time     Callsign          Sent     Rcvd           Notes"
  298. PRINT #2, "   "; STRING$(74,61)
  299. THEDATE$=STR$(DAY)+BLANK$+MON$
  300. RETURN
  301.